home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 15 / BBS in a box XV-1.iso / Files / Tele / Pete Johnson / Flip 1.0.3<source>.sit / TxWrite.p < prev    next >
Encoding:
Text File  |  1990-08-18  |  1.6 KB  |  80 lines  |  [TEXT/PJMM]
  1. unit TxWrite;
  2.  
  3.  
  4. interface
  5.  
  6.     uses
  7.         HelloTabby;
  8.  
  9.     procedure MakeTextFile (FileName: STR255);
  10.     function AtEOF (fRefNum: Integer): Boolean;
  11.     function Wr (FileRefNum: integer; TheMessage: str255): OSErr;
  12.     function WrLn (FileRefNum: integer; TheMessage: str255): OSErr;
  13.  
  14. implementation
  15.  
  16. {-----------------------------------------------------------------    }
  17.  
  18.     procedure MakeTextFile;
  19.  
  20. {    Sets up QUED-compatible text  file                    }
  21.  
  22.         var
  23.             fndrInfo: FInfo;
  24.  
  25.     begin
  26.         Err := GetFInfo(FileName, vRefNum, fndrInfo);
  27.         if Err = noErr then
  28.             begin
  29.                 fndrInfo.fdType := 'TEXT';
  30.                 fndrInfo.fdCreator := 'QED1';
  31.                 Err := SetFInfo(FileName, vRefNum, fndrInfo);
  32.             end
  33.         else
  34.             Err := Create(FileName, vRefNum, 'QED1', 'TEXT');
  35.     end;
  36.  
  37. { ------------------------------------------------------ }
  38.  
  39.     function AtEOF;
  40.  
  41.         var
  42.             Err: OSErr;
  43.             currPos, eofPos: LongInt;
  44.  
  45.     begin
  46.         Err := GetFPos(fRefNum, currPos);
  47.         Err := GetEOF(fRefNum, eofPos);
  48.         AtEOF := currPos = eofPos
  49.     end;
  50.  
  51. { ------------------------------------------------------ }
  52.  
  53.     function Wr;
  54.  
  55. {    Writes string (without length byte) to text file, returns error code    }
  56.  
  57.         var
  58.             TheLength: longint;
  59.  
  60.     begin
  61.         TheLength := length(TheMessage);
  62.         Wr := FSWrite(FileRefNum, TheLength, Pointer(ord(@TheMessage) + 1))
  63.     end;
  64.  
  65. { ------------------------------------------------------ }
  66.  
  67.     function WrLn;
  68.  
  69. {    Writes string (without length byte) to text file, returns error code    }
  70.  
  71.         const
  72.             ENDLINE = chr(13);
  73.  
  74.     begin
  75.         TheMessage := concat(TheMessage, ENDLINE);
  76.         WrLn := Wr(FileRefNum, TheMessage)
  77.     end;
  78.  
  79. { ------------------------------------------------------ }
  80. end.